home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / unix / tclLoadDl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  3.9 KB  |  136 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclLoadDl.c --
  3.  *
  4.  *    This procedure provides a version of the TclLoadFile that
  5.  *    works with the "dlopen" and "dlsym" library procedures for
  6.  *    dynamic loading.
  7.  *
  8.  * Copyright (c) 1995 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tclLoadDl.c 1.8 96/12/03 16:57:00
  14.  */
  15.  
  16. #include "tclInt.h"
  17. #ifdef NO_DLFCN_H
  18. #   include "../compat/dlfcn.h"
  19. #else
  20. #   include <dlfcn.h>
  21. #endif
  22.  
  23. /*
  24.  * In some systems, like SunOS 4.1.3, the RTLD_NOW flag isn't defined
  25.  * and this argument to dlopen must always be 1.  The RTLD_GLOBAL
  26.  * flag is needed on some systems (e.g. SCO and UnixWare) but doesn't
  27.  * exist on others;  if it doesn't exist, set it to 0 so it has no effect.
  28.  */
  29.  
  30. #ifndef RTLD_NOW
  31. #   define RTLD_NOW 1
  32. #endif
  33.  
  34. #ifndef RTLD_GLOBAL
  35. #   define RTLD_GLOBAL 0
  36. #endif
  37.  
  38. /*
  39.  *----------------------------------------------------------------------
  40.  *
  41.  * TclLoadFile --
  42.  *
  43.  *    Dynamically loads a binary code file into memory and returns
  44.  *    the addresses of two procedures within that file, if they
  45.  *    are defined.
  46.  *
  47.  * Results:
  48.  *    A standard Tcl completion code.  If an error occurs, an error
  49.  *    message is left in interp->result.  *proc1Ptr and *proc2Ptr
  50.  *    are filled in with the addresses of the symbols given by
  51.  *    *sym1 and *sym2, or NULL if those symbols can't be found.
  52.  *
  53.  * Side effects:
  54.  *    New code suddenly appears in memory.
  55.  *
  56.  *----------------------------------------------------------------------
  57.  */
  58.  
  59. int
  60. TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
  61.     Tcl_Interp *interp;        /* Used for error reporting. */
  62.     char *fileName;        /* Name of the file containing the desired
  63.                  * code. */
  64.     char *sym1, *sym2;        /* Names of two procedures to look up in
  65.                  * the file's symbol table. */
  66.     Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
  67.                 /* Where to return the addresses corresponding
  68.                  * to sym1 and sym2. */
  69. {
  70.     VOID *handle;
  71.     Tcl_DString newName;
  72.  
  73.     handle = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL);
  74.     if (handle == NULL) {
  75.     Tcl_AppendResult(interp, "couldn't load file \"", fileName,
  76.         "\": ", dlerror(), (char *) NULL);
  77.     return TCL_ERROR;
  78.     }
  79.  
  80.     /* 
  81.      * Some platforms still add an underscore to the beginning of symbol
  82.      * names.  If we can't find a name without an underscore, try again
  83.      * with the underscore.
  84.      */
  85.  
  86.     *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym1);
  87.     if (*proc1Ptr == NULL) {
  88.     Tcl_DStringInit(&newName);
  89.     Tcl_DStringAppend(&newName, "_", 1);
  90.     Tcl_DStringAppend(&newName, sym1, -1);
  91.     *proc1Ptr = (Tcl_PackageInitProc *) dlsym(handle,
  92.         Tcl_DStringValue(&newName));
  93.     Tcl_DStringFree(&newName);
  94.     }
  95.     *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle, (char *) sym2);
  96.     if (*proc2Ptr == NULL) {
  97.     Tcl_DStringInit(&newName);
  98.     Tcl_DStringAppend(&newName, "_", 1);
  99.     Tcl_DStringAppend(&newName, sym2, -1);
  100.     *proc2Ptr = (Tcl_PackageInitProc *) dlsym(handle,
  101.         Tcl_DStringValue(&newName));
  102.     Tcl_DStringFree(&newName);
  103.     }
  104.     return TCL_OK;
  105. }
  106.  
  107. /*
  108.  *----------------------------------------------------------------------
  109.  *
  110.  * TclGuessPackageName --
  111.  *
  112.  *    If the "load" command is invoked without providing a package
  113.  *    name, this procedure is invoked to try to figure it out.
  114.  *
  115.  * Results:
  116.  *    Always returns 0 to indicate that we couldn't figure out a
  117.  *    package name;  generic code will then try to guess the package
  118.  *    from the file name.  A return value of 1 would have meant that
  119.  *    we figured out the package name and put it in bufPtr.
  120.  *
  121.  * Side effects:
  122.  *    None.
  123.  *
  124.  *----------------------------------------------------------------------
  125.  */
  126.  
  127. int
  128. TclGuessPackageName(fileName, bufPtr)
  129.     char *fileName;        /* Name of file containing package (already
  130.                  * translated to local form if needed). */
  131.     Tcl_DString *bufPtr;    /* Initialized empty dstring.  Append
  132.                  * package name to this if possible. */
  133. {
  134.     return 0;
  135. }
  136.